home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / games_d / hunchy.zip / HB.PAS < prev    next >
Pascal/Delphi Source File  |  1994-03-17  |  25KB  |  1,023 lines
  1. program HUNCHBACK;
  2.  
  3. uses Dos,Crt,Graph3,Graph;
  4.  
  5. const
  6.   On=True;
  7.   Off=False;
  8.   Hdir='';
  9.   Icons=19;
  10.   Walls=12;
  11.   MaxWeapon=20;
  12.   GrdIcn:array[1..10] of byte=(14,14,15,15,16,16,16,15,15,14);
  13.   No:array[1..10] of byte=(1,2,3,2,4,5,6,5,7,8);
  14.   Ad:array[1..10] of shortint=(0,2,0,2,0,4,2,4,-2,-9);
  15.  
  16. type
  17.   ScrTyp=array[1..16368] of byte;
  18.   IcnTyp=array[1..185] of byte;
  19.   WpnTyp=record
  20.     Typ,Yps:byte;
  21.     Spd:shortint;
  22.     Int,Del,Cnt,Xps:word;
  23.     Fst:boolean;
  24.   end;
  25.   HiscTyp=array [1..7] of record
  26.     Name:string[20];
  27.     Scor:integer;
  28.   end;
  29.   Str80=string[80];
  30.   Str255=string[255];
  31.  
  32. var
  33.   Screen:ScrTyp absolute $B800:$0000;
  34.   Icon:array[1..Icons] of IcnTyp;
  35.   BlIcon:array[1..800] of byte;
  36.   Regs:Registers;
  37.   Ctr,Ctr2:word;
  38.   Behind:IcnTyp;
  39.   Gd,Gm,StringTop,
  40.   ox,x,oy,y,NextXlife,
  41.   Walk,OWlk,Wmin,Wmax,Pause,Score,
  42.   Rx,Urx,Orx,Ourx,Bonus,BonCnt:integer;
  43.   xd,oxd,yd,oyd,Rxd,Hanging:shortint;
  44.   Jmp,GrdCnt,GrdNo,Weapons,WallNo,Lives,
  45.   StartLevel,StartWall,Level,LastPos:byte;
  46.   Key:char;
  47.   Reached,Rope,Guards,Pits,LetGo,UseFont,
  48.   Started,Falling,FirstFall,Dead,Quit,
  49.   RgtShft,LftShft,NumLk,CapsLk,ScrlLk,Ins:boolean;
  50.   Weapon:array[1..MaxWeapon] of WpnTyp;
  51.   Wall:array[1..12,1..200] of integer;
  52.   Octave,Tempo:byte;
  53.   AllLength,Music:real;
  54.   Step,TuneStopped,TitleMusic:boolean;
  55.   Hisc:HiscTyp;
  56.   HiscFil:file of HiscTyp;
  57.   Publ,Auth,Adrs,City:Str80;
  58.  
  59.  
  60. procedure GameFont; external;
  61. {$L FONT.OBJ}
  62.  
  63.  
  64. procedure Sound1(Frq:word);
  65. begin
  66.   if not ScrlLk then Sound(Frq);
  67. end;
  68.  
  69. procedure Sound(Frq:word);
  70. begin
  71.   Sound1(Frq);
  72. end;
  73.  
  74. procedure GetShiftStats;
  75. begin
  76.   with Regs do begin
  77.     AH:=$2;
  78.     Intr($16,Regs);
  79.     RgtShft:=(AL and 1)=1;
  80.     LftShft:=(AL and 2)=2;
  81.     ScrlLk:=(AL and 16)=16;
  82.     NumLk:=(AL and 32)=32;
  83.     CapsLk:=(AL and 64)=64;
  84.     Ins:=(AL and 128)=128;
  85.   end;
  86. end;
  87.  
  88. function St(Num:integer):Str80;
  89. var Temp:Str80;
  90. begin
  91.   Str(Num,Temp);
  92.   St:=Temp;
  93. end;
  94.  
  95. {$I HPLAY.INC}
  96.  
  97. procedure Wnum(Value:integer; Nums,x,y:byte);
  98. var
  99.   St:Str80;
  100.   Ctr:byte;               { The new font works only on 100% PC compatibles, }
  101.   Ch:char;                { no ATs, then the original font is used }
  102. begin
  103.   Str(Value:Nums,St);
  104.   GotoXY(x,y);
  105.   for Ctr:=1 to Length(St) do begin
  106.     Ch:=St[Ctr];
  107.     if Ch=' ' then Ch:='0';
  108.     if UseFont then if Ch in ['0'..'9'] then Inc(Ch,128);
  109.     Write(Ch);
  110.   end;
  111. end;
  112.  
  113. procedure Wstr(Txt:Str255);
  114. var
  115.   Ctr:byte;
  116. begin
  117.   for Ctr:=1 to Length(Txt) do
  118.     Write(Chr(Ord(Txt[Ctr])+(128*Ord(UseFont))));
  119. end;
  120.  
  121. function GetInput(x,y,Len,Col:byte):Str80;
  122. var
  123.   Tmp:Str80;
  124.   Pos:byte absolute Tmp;
  125.   Key:char;
  126. begin
  127.   Pos:=0;
  128.   TextColor(Col);
  129.   Tmp:='';
  130.   repeat
  131.     GotoXY(x+Pos,y);
  132.     Write(#150);
  133.     Key:=ReadKey;
  134.     case Ord(Key) of
  135.       32..126:if Pos<Len then begin
  136.         Write(#8,Chr(Ord(Key)+128));
  137.         Inc(Pos);
  138.         Tmp[Pos]:=Key;
  139.       end;
  140.       8:if Pos>0 then begin
  141.         Write(#8#32);
  142.         Dec(Pos);
  143.       end;
  144.     end;
  145.   until (Key=#13) and (Tmp<>'');
  146.   GetInput:=Tmp;
  147. end;
  148.  
  149. function Smallest(A,B:integer):integer;
  150. begin
  151.   if A<B then Smallest:=A
  152.   else Smallest:=B;
  153. end;
  154.  
  155. procedure Count(var V:integer; Add,Low,High:word);
  156. begin
  157.   Inc(V,Add);
  158.   if V<Low then V:=High;
  159.   if V>High then V:=Low;
  160. end;
  161.  
  162. procedure Black(x,y,xs,ys:word);
  163. begin
  164.   BlIcon[3]:=xs; BlIcon[5]:=ys;
  165.   PutPic(BlIcon,x,y);
  166. end;
  167.  
  168. function ImSize(x1,y1,x2,y2:word):word;
  169. var
  170.   x,y:word;
  171. begin
  172.   x:=x2-x1+1; Y:=y2-y1+1;
  173.   ImSize:=(6+Trunc((x*2+7)/8)*y);
  174. end;
  175.  
  176. procedure Box(x,y,x1,y1:word);
  177. begin
  178.   SetFillStyle(1,0);
  179.   Bar(x,y,x1,y1);
  180.   SetColor(2);
  181.   MoveTo(x,y); LineTo(x,y1); LineTo(x1,y1);
  182.   SetColor(1);
  183.   LineTo(x1,y); LineTo(x,y);
  184. end;
  185.  
  186. procedure OutLine(x,y:integer; Txt:Str80; OCol,TCol:byte);
  187. var ax,ay:shortint;
  188. begin
  189.   SetColor(Ocol);
  190.   for ay:=-1 to 1 do
  191.     for ax:=-1 to 1 do if(ax<>0) or(ay<>0) then
  192.       OutTextXY(x+ax,y+ay,Txt);
  193.   SetColor(TCol);
  194.   OutTextXY(x,y,Txt);
  195. end;
  196.  
  197. procedure LoadHiScores;
  198. var Ctr:byte;
  199. begin
  200.   Assign(HiscFil,Hdir+'HISC.DAT'); {$I-}
  201.   Reset(HiscFil);                  {$I+}
  202.   case(IOresult=0) of
  203.     True:begin
  204.       Read(HiscFil,Hisc);
  205.       Close(HiscFil);
  206.     end;
  207.     False:for Ctr:=1 to 7 do with Hisc[Ctr] do begin
  208.       case(Ctr mod 2=1) of
  209.         True:Name:='Robert Schmidt';
  210.         False:Name:='FireBall Software';
  211.       end;
  212.       Scor:=(11-Ctr)*200;
  213.     end;
  214.   end;
  215. end;
  216.  
  217. procedure SaveHiScores;
  218. begin
  219.   Assign(HiscFil,Hdir+'HISC.DAT');
  220.   ReWrite(HiscFil);
  221.   Write(HiscFil,Hisc);
  222.   Close(HiscFil);
  223. end;
  224.  
  225. procedure Video(State:boolean);
  226. begin
  227.   case State of
  228.     On:Port[$3d8]:=$A;      { Quick and dirty !! }
  229.     Off:Port[$3d8]:=2;      { May not work on ATs }
  230.   end;
  231. end;
  232.  
  233. function Decode(Txt:Str80):Str80;  { Just a vacsine against pirates }
  234. var Ctr:byte;
  235. begin
  236.   for Ctr:=1 to Length(Txt) do
  237.     Dec(Txt[Ctr],128);         
  238.   Decode:=Txt;
  239. end;
  240.  
  241. procedure Wlin(y:integer; Txt:Str255);
  242. begin
  243.   OutTextXY(160,y,Txt);
  244. end;
  245.  
  246. procedure Initialize;
  247. var
  248.   IcnFil:file of byte;
  249.   WalFil:file of integer;
  250.   Tmp:IcnTyp;
  251.   IconNo,WallNo:byte;
  252.   Isize,Cnt:word;
  253.   Dat,Gd,Gm:integer;
  254. begin
  255.   Randomize;
  256.   NoSound;
  257.   SetIntVec($1F,@GameFont);
  258.   InitPlay;
  259.     GraphColorMode;
  260.     Gd:=CGA;
  261.     Gm:=CGAC0;
  262.     InitGraph(Gd,Gm,'');
  263.   DirectVideo:=Off;
  264.   Video(Off);
  265.   GotoXY(1,1); Write(#150);
  266.   UseFont:=(Screen[1]=255);
  267.   ClearDevice;
  268.   GotoXY(12,9); Wstr('Loading Hunchback...');
  269.   TextColor(1);
  270.   GotoXY(8,11); Wstr('Please wait a few seconds...');
  271.   Video(On);
  272.   Publ:=Decode('╞Θ≥σ┬ß∞∞á╙∩µ⌠≈ß≥σá╠⌠Σ');
  273.   Auth:=Decode('╥∩Γσ≥⌠á╙πΦφΘΣ⌠');
  274.   Adrs:=Decode('╧∞σá╬∩≥Στßß≥Σ≤÷σΘá┤┤');
  275.   City:=Decode('╖░┤╣á╘≥∩εΣΦσΘφ¼á╬╧╥╫┴┘');
  276.     GetPic(BlIcon,0,0,25,25);
  277.   CheckEOF:=Off;
  278.   CheckBreak:=Off;
  279.   Assign(IcnFil,Hdir+'ICONS.DAT');
  280.   Reset(IcnFil);
  281.   IconNo:=1;
  282.   while(not Eof(IcnFil)) and(IconNo<=Icons) do begin
  283.     for Ctr:=1 to 6 do
  284.       Read(IcnFil,Tmp[Ctr]);
  285.     Isize:=ImSize(1,1,Tmp[4]*256+Tmp[3],Tmp[6]*256+Tmp[5]);
  286.     for Ctr:=7 to Isize do
  287.       Read(IcnFil,Tmp[Ctr]);
  288.     Icon[IconNo]:=Tmp;
  289.     Inc(IconNo);
  290.   end;
  291.   Close(IcnFil);
  292.   FillChar(Wall,SizeOf(Wall),#0);
  293.   Assign(WalFil,Hdir+'WALL.DAT');
  294.   Reset(WalFil);
  295.   WallNo:=0;
  296.   Read(WalFil,Dat);
  297.   while(not Eof(WalFil)) and(WallNo<Walls) do begin
  298.     if Dat=MaxInt then begin
  299.       Inc(WallNo);
  300.       Cnt:=1; repeat
  301.         Read(WalFil,Dat);
  302.         if Dat<>MaxInt then Wall[WallNo,Cnt]:=Dat;
  303.         Inc(Cnt);
  304.       until(Dat=MaxInt) or Eof(WalFil);
  305.       Writeln;
  306.     end;
  307.   end;
  308.   LoadHiScores;
  309.  
  310.   Video(Off);
  311.   ClearDevice;
  312.   SetTextJustify(CenterText,TopText);
  313.   SetTextStyle(GothicFont,0,5);
  314.   SetColor(2); OutTextXY(158,-3,'HUNCHBACK');
  315.   SetColor(3); OutTextXY(160,-5,'HUNCHBACK');
  316.   SetTextStyle(TriplexFont,0,0);
  317.   SetUserCharSize(2,3,2,5);
  318.   SetColor(1); Wlin(34,'Version 1.02');
  319.   SetUserCharSize(1,2,1,2);
  320.   SetColor(2); Wlin(45,'Programming, graphics and sound by');
  321.   Wlin(85,'Copyright (C) 1988 & 1989 of');
  322.   SetUserCharSize(7,10,7,10);
  323.   SetColor(3); Wlin(62,Auth);
  324.   Wlin(101,Copy(Publ,1,17)+' Limited');
  325.   SetTextStyle(SmallFont,0,0);
  326.   SetUserCharSize(1,1,1,1);
  327.   SetColor(2); Wlin(122,'Write to: '+Publ+', c/o '+Auth+',');
  328.   Wlin(131,Adrs+', '+City);
  329.   SetUserCharSize(1,1,1,1);
  330.   SetColor(1);
  331.   Wlin(145,'This product is distributed under the FreeWare Concept.');
  332.   Wlin(155,'You may therefore freely share a copy of the program');
  333.   Wlin(165,'to your friends, but without demanding any kind of fee');
  334.   Wlin(175,'or payment. If you enjoy the game, a contribution of');
  335.   Wlin(185,'approximately $15 will be most appreciated.');
  336.   Video(On);
  337.  
  338.   SetTextJustify(LeftText,TopText);
  339.   LastPos:=0;
  340.   StartLevel:=1; StartWall:=1;
  341.   Dead:=False; Quit:=False;
  342.   Key:=ReadKey;
  343. end;
  344.  
  345. procedure ShowTitle;
  346. var
  347.   Ctr,Col,Rank:byte;
  348.   PrevSc:integer;
  349.   TitFil:file of ScrTyp;
  350.   Slch,Swch:char;
  351. begin
  352.   TitleMusic:=On;
  353.   TuneStopped:=False;
  354.   Assign(TitFil,Hdir+'TITLE.PIC');
  355.   Reset(TitFil);
  356.   Video(Off);
  357.   ClearDevice;
  358.   Read(TitFil,Screen);
  359.   Video(On);
  360.   Close(TitFil);
  361.   Play('t160 o3 l8');
  362.   repeat
  363.     Ctr:=1;
  364.     repeat
  365.       case Ctr of
  366.         1:Octave:=3;
  367.         2:Octave:=5;
  368.         3:Octave:=1;
  369.       end;
  370.       Play('a>c4de.f#16ed4<bg.a16b>c4<aa.g16ab4ge4'+
  371.            'a>c4de.f#16ed4<bg.a16b>c.<b16ag#.f#16g#a4.a4p'+
  372.            '>g4.g.f#16ed4<bg.a16b>c4<aa.g#16ab4g#e4.'+
  373.            '>g4.g.f#16ed4<bg.a16b>c.<b16ag#.f#16g#a4.a4p4');
  374.       Inc(Ctr);
  375.     until(Ctr>3) or TuneStopped;
  376.   until TuneStopped;
  377.  
  378.   while KeyPressed do Key:=ReadKey;
  379.   TitleMusic:=Off;
  380.   TuneStopped:=False;
  381.   Video(Off);
  382.   ClearDevice;
  383.   SetTextJustify(CenterText,TopText);
  384.   SetTextStyle(GothicFont,0,4);
  385.   SetColor(3); Wlin(-7,'Hunchback');
  386.   SetTextStyle(GothicFont,0,2);
  387.   OutTextXY(40,148,'Hall Of');
  388.   OutTextXY(40,168,'Fame');
  389.   SetTextStyle(SmallFont,0,4);
  390.   SetTextJustify(LeftText,TopText);
  391.   PrevSc:=0; Rank:=0;
  392.   for Ctr:=1 to 7 do begin
  393.     Col:=1+Ord(Ctr=LastPos)*2;
  394.     TextColor(Col);
  395.     with Hisc[Ctr] do begin
  396.       GotoXY(12,Ctr+18);
  397.       if Scor<>PrevSc then Inc(Rank);
  398.       Wstr(St(Rank)+' '+Name);
  399.       Wnum(Scor,5,35,Ctr+18);
  400.       PrevSc:=Scor;
  401.     end;
  402.   end;
  403.   SetTextStyle(SmallFont,0,4);
  404.   SetTextJustify(CenterText,TopText);
  405.   SetColor(2);
  406.   Wlin(26,'In this game, you play the role of Quasimodo, whose');
  407.   Wlin(34,'purpose is to reach the other end of the huge castle');
  408.   Wlin(42,'wall, where the beautiful princess Esmeralda is kept');
  409.   Wlin(50,'captured in the castle tower. To continue to the next');
  410.   Wlin(58,'part of the wall, you''ll have dodge several obstacles');
  411.   Wlin(66,'to reach the bell and ring it. Watch out for arrows,');
  412.   Wlin(74,'cannonballs and stabbing guards.');
  413.   Wlin(82,'To make Quasimido walk, use the left and right SHIFT');
  414.   Wlin(90,'keys. Press Enter or Spacebar to jump.');
  415.   SetColor(1);
  416.   OutTextXY(65,100,'Choose skill level:');
  417.   OutTextXY(65,108,'(Press 1-3)');
  418.   OutTextXY(210,100,'Choose start wall:');
  419.   OutTextXY(210,108,'(Press A-L)');
  420.   SetColor(2);
  421.   Rectangle(124,101,145,119);
  422.   Rectangle(267,101,287,119);
  423.   SetColor(3); Wlin(119,'Press Enter or Spacebar to start, ESC to quit.');
  424.   SetColor(2); Wlin(129,'Scroll Lock toggles sound, Num Lock toggles pause.');
  425.   SetColor(3); SetTextStyle(GothicFont,0,2);
  426.   SetTextJustify(LeftText,TopText);
  427.   Video(On);
  428.   repeat
  429.     Slch:=Chr(48+StartLevel);
  430.     Swch:=Chr(64+StartWall);
  431.     OutTextXY(130,99,Slch);
  432.     OutTextXY(270,99,Swch);
  433.     Key:=UpCase(ReadKey);
  434.     case Key of
  435.       '1'..'3':begin
  436.         StartLevel:=Ord(Key)-48;
  437.         Black(130,117,15,15);
  438.       end;
  439.       'A'..'L':begin
  440.         StartWall:=Ord(Key)-64;
  441.         Black(270,117,15,15);
  442.       end;
  443.     end;
  444.   until Key in [#13,#32,#27];
  445.   if Key=#27 then Quit:=True;
  446.   SetTextStyle(DefaultFont,0,1);
  447. end;
  448.  
  449. procedure ScrollLeft;
  450. type
  451.   ScrHalf=array [0..100,0..79] of byte;
  452. var
  453.   Scr1:ScrHalf absolute $B800:0000;
  454.   Scr2:ScrHalf absolute $B800:8112;
  455.   Line:byte;
  456. begin
  457.   for Line:=0 to 100 do begin
  458.     Move(Scr1[Line,4],Scr1[Line,0],80);
  459.     Move(Scr2[Line,4],Scr2[Line,0],80);
  460.   end;
  461. (*  Move(Screen[5],Screen,16384);*)
  462. end;
  463.  
  464. procedure Game;
  465.   procedure BellString;
  466.   begin
  467.     SetColor(3);
  468.     Line(307,StringTop,307,93);
  469.   end;
  470.  
  471.   procedure TurnLeft;
  472.   begin
  473.     if not(Walk in [1..4]) then begin
  474.       Walk:=2;
  475.       Wmin:=1; Wmax:=4;
  476.     end;
  477.     xd:=-1;
  478.   end;
  479.  
  480.   procedure TurnRight;
  481.   begin
  482.     if not(Walk in [5..8]) then begin
  483.       Walk:=6;
  484.       Wmin:=5; Wmax:=8;
  485.     end;
  486.     xd:=1;
  487.   end;
  488.  
  489.   procedure Man;
  490.   begin
  491.     if Falling then begin
  492.       Sound((400-y)*5);
  493.       Inc(y,7+4*Ord(y>127));
  494.       if y>200 then Dead:=True;
  495.       if oy>103 then PutPic(Behind,ox,oy);
  496.       if oy<122 then Black(ox,Smallest(103,oy),17,19);
  497.       GetPic(Behind,x,y,x+14,y-18);
  498.     end else begin
  499.       if(Owlk<>Walk) or(oy<>y) or(ox<>x) then Black(ox+Ad[Owlk],oy,15,19);
  500.       if Reached then BellString;
  501.     end;
  502.     PutPic(Icon[No[Walk]],x+Ad[Walk],y);
  503.   end;
  504.  
  505.   procedure ShowGuards;
  506.   var
  507.     xp:word;
  508.     Gicn:IcnTyp;
  509.   begin
  510.     for Ctr:=1 to 3 do begin
  511.       xp:=Ctr*80-8;
  512.       if Ctr=GrdNo then begin
  513.         Gicn:=Icon[GrdIcn[GrdCnt]];
  514.         if GrdCnt>7 then Black(xp,119-GIcn[5],3,6);
  515.         if(xp>x-1)and(xp<x+15)and(GrdIcn[GrdCnt]>14) then Falling:=True;
  516.       end else Gicn:=Icon[14];
  517.       PutPic(Gicn,xp,119);
  518.     end;
  519.   end;
  520.  
  521.   procedure ShowLives;
  522.   var Ctr:byte;
  523.   begin
  524.     if Lives>1 then for Ctr:=1 to Lives-1 do
  525.       PutPic(Icon[4],(Ctr-1)*19,17);
  526.   end;
  527.  
  528.   procedure KillLife;
  529.   var Ctr:byte;
  530.   begin
  531.     Dec(Lives);
  532.     if Lives>0 then begin
  533.       SetColor(0);
  534.       for Ctr:=18 to 103 do begin
  535.         PutPic(Icon[4],0,Ctr);
  536.         Line(5,Ctr-18,13,Ctr-18);
  537.         Delay(2);
  538.       end;
  539.       Play('t200 l8 o3 e4ep64eeea2');
  540.     end;
  541.     Black((Lives-1)*19,17,15,18);
  542.     ShowLives;
  543.   end;
  544.  
  545.   procedure ShowScore(Adj:integer; Cnt:boolean);
  546.   var Ctr:integer;
  547.     procedure Wsc;
  548.     begin
  549.       TextColor(3);
  550.       Wnum(Score,5,15,2);
  551.     end;
  552.   begin
  553.     case Cnt of
  554.       True:begin
  555.         for Ctr:=1 to Adj div 10 do begin
  556.           Inc(Score,10);
  557.           Wsc;
  558.           Delay(10);
  559.         end;
  560.         Inc(Score,Adj mod 10);
  561.         Wsc;
  562.       end;
  563.       False:begin
  564.         Inc(Score,Adj);
  565.         Wsc;
  566.       end;
  567.     end;
  568.     if Score>=NextXlife then begin
  569.       if Lives<6 then begin
  570.         Inc(Lives);
  571.         ShowLives;
  572.         Play('t200 l4 o5 cc8ceg>c2');
  573.       end;
  574.       Inc(NextXlife,1500);
  575.     end;
  576.   end;
  577.  
  578.   procedure ShowBonus;
  579.   begin
  580.     TextColor(3);
  581.     Wnum(Bonus,3,27,20);
  582.   end;
  583.  
  584.   procedure ShowMap;
  585.   begin
  586.     OutLine(78,132,'Wall '+Chr(64+WallNo),0,1);
  587.     Box(62,141,141,168);
  588.     TextColor(2);
  589.     GotoXY(9,21); Write(#138#139#139#139#139#139#139#139#139);
  590.     GotoXY(16,20); Write(#142#139);
  591.     GotoXY(16,19); Write(#140#141);
  592.     PutPic(Icon[17],70+4*WallNo,159);
  593.   end;
  594.  
  595.   procedure ClearObstacles;
  596.   begin
  597.     if Weapons>0 then for Ctr:=1 to Weapons do with Weapon[Ctr] do
  598.       Black(Xps,Yps,Icon[10+Typ,3],Icon[10+Typ,5]);
  599.     if Rope then begin
  600.       SetColor(0); Line(Urx,20,Rx,76);
  601.     end;
  602.     if Guards then for Ctr:=1 to 3 do
  603.       Black(Ctr*80-8,119-Icon[14,5],3,12);
  604.   end;
  605.  
  606.   procedure InitGame;
  607.   begin
  608.     Lives:=4;
  609.     Level:=StartLevel;
  610.     Score:=0;
  611.     NextXlife:=1500;
  612.     WallNo:=StartWall;
  613.     Reached:=True;
  614.     Started:=True;
  615.   end;
  616.  
  617.   procedure NewWall;
  618.     procedure GetWallData;
  619.     var
  620.       WeapNo:byte;
  621.     begin
  622.       Rope:=Off; Guards:=Off; Pits:=Off;
  623.       case Wall[WallNo,1] of
  624.         1:Rope:=On;
  625.         2:begin
  626.           Guards:=On;
  627.           Pits:=On;
  628.         end;
  629.         3:Pits:=On;
  630.       end;
  631.       Weapons:=Wall[WallNo,2];
  632.       if Weapons>0 then begin
  633.         Ctr:=3; WeapNo:=1;
  634.         repeat
  635.           with Weapon[WeapNo] do begin
  636.             Typ:=Wall[WallNo,Ctr];
  637.             Yps:=Wall[WallNo,Ctr+1];
  638.             Spd:=Wall[WallNo,Ctr+2];
  639.             Int:=Wall[WallNo,Ctr+3];
  640.             Del:=Wall[WallNo,Ctr+4];
  641.           end;
  642.           Inc(Ctr,5);
  643.           Inc(WeapNo);
  644.         until WeapNo>Weapons;
  645.       end;
  646.     end;
  647.     procedure SideWall(BrX,BrY:byte);
  648.     var x,y:word;
  649.     begin
  650.       x:=BrX*16; y:=BrY*16+8;
  651.       Line(x,y,x,y+16);
  652.       Line(x+1,y,x+1,y+16);
  653.     end;
  654.     procedure Brick(BrX,BrY:byte);
  655.     begin
  656.       PutPic(Icon[9],BrX*16,BrY*16+23);
  657.     end;
  658.   begin
  659.     LetGo:=False;
  660.     SetColor(3);
  661.     GetWallData;
  662.     for Ctr:=0 to 19 do begin
  663.       for Ctr2:=0 to 13 do Black(0,Ctr2*16,16,16);
  664.       ScrollLeft;
  665.       if(WallNo=Walls) and(Ctr>=17) then begin
  666.         Brick(19,0);
  667.         Brick(19,3);
  668.         MoveTo(304,24); LineRel(16,0);
  669.         MoveRel(0,1); LineRel(-16,0);
  670.         case Ctr of
  671.           17:begin Brick(19,1); SideWall(19,1);
  672.             Brick(19,2); SideWall(19,2);
  673.             SideWall(19,0); SideWall(19,3);
  674.           end;
  675.           18:begin SideWall(19,1); SideWall(19,2); end;
  676.         end;
  677.         Black(304,73,16,8);
  678.       end;
  679.       for Ctr2:=6 to 11 do begin
  680.         if not((Rope and(Ctr2=6) and(Ctr in [4..14]))
  681.         or(Pits and(Ctr2=6) and(Ctr in [4,5,9,10,14,15]))) then
  682.           Brick(19,Ctr2);
  683.         if Ctr2=6 then begin
  684.           if Rope then if Ctr in [4,15] then SideWall(19,Ctr2);
  685.           if Pits then if Ctr in [4,6,9,11,14,16] then SideWall(19,Ctr2);
  686.         end;
  687.       end;
  688.     end;
  689.     if WallNo<Walls then begin
  690.       PutPic(Icon[10],300,20); StringTop:=21;
  691.     end else begin
  692.       PutPic(Icon[18],308,55); StringTop:=50;
  693.     end;
  694.     if Guards then ShowGuards;
  695.     SetColor(2);
  696.     OutTextXY(112,0,'Score');
  697.     OutTextXY(175,1,'Hi');
  698.     ShowScore(0,Off);
  699.     BellString;
  700.     ShowMap;
  701.     ShowLives;
  702.     Bonus:=500; BonCnt:=0;
  703.     Box(199,149,239,161);
  704.     OutLine(200,140,'Bonus',0,1);
  705.     ShowBonus;
  706.     if Started then begin
  707.       KillLife;
  708.       Started:=False;
  709.     end;
  710.   end;
  711.  
  712.   procedure InitWall;
  713.   begin
  714.     FirstFall:=True;
  715.     x:=0; y:=103; xd:=0; yd:=0;
  716.     ox:=x; oy:=y; oxd:=xd; oyd:=yd;
  717.     Jmp:=0;
  718.     Walk:=5; Wmin:=5; Wmax:=8;
  719.     if Reached then NewWall;
  720.     Reached:=False;
  721.     Hanging:=0; LetGo:=False;
  722.     if Rope then begin
  723.       Rx:=Random(97)+104; Urx:=Rx; Rxd:=-1+Random(2)*2;
  724.     end;
  725.     if Guards then begin
  726.       GrdCnt:=0;
  727.       GrdNo:=0;
  728.       ShowGuards;
  729.     end;
  730.     Falling:=False; Dead:=False;
  731.     Man;
  732.     if Weapons>0 then for Ctr:=1 to Weapons do with Weapon[Ctr] do begin
  733.       Fst:=True; Cnt:=1;
  734.     end;
  735.   end;
  736.  
  737.   procedure ProcessJump;
  738.   const
  739.     JmpLen=8;
  740.     Ychg:array[1..JmpLen] of shortint=(-8,-6,-3,-2,2,3,6,8);
  741.   begin
  742.     if Rope and not LetGo then if(Rx in [x..x+15]) and(y<101) then begin
  743.       case xd of
  744.         -1:Hanging:=1;
  745.         +1:Hanging:=2;
  746.       end;
  747.       ShowScore(5,Off);
  748.       xd:=0;
  749.       Walk:=Hanging+8;
  750.     end;
  751.     if Hanging=0 then begin
  752.       if Jmp=JmpLen+2 then begin
  753.         Inc(y,7);
  754.         if y>=103 then begin
  755.           y:=103;
  756.           Dec(Jmp);
  757.         end;
  758.       end else begin
  759.         Inc(y,Ychg[Jmp]);
  760.         if Jmp<6 then Sound(Jmp*150+500);
  761.         Inc(Jmp);
  762.       end;
  763.       if Jmp=JmpLen+1 then begin
  764.         if y<103 then Inc(Jmp) else begin
  765.           Jmp:=0;
  766.         end;
  767.       end;
  768.     end;
  769.   end;
  770.  
  771.   procedure ProcessWpn;
  772.     procedure MoveWpn(W:byte);
  773.     var wx,wy:word;
  774.     begin
  775.       with Weapon[W] do begin
  776.         if Typ=1 then Black(Xps,Yps,14,9)
  777.         else Black(Xps,Yps,20,3);
  778.         Inc(Xps,Spd);
  779.         if(Xps>320) then Cnt:=1
  780.         else begin
  781.           wx:=Xps; wy:=Yps;
  782.           PutPic(Icon[Typ+10],wx,wy);
  783.           case Typ of
  784.             1:if((wx>x-12)and(wx<x+14)) and((wy>y-18)and(wy<y+8)) then
  785.               Falling:=True;
  786.             2,3:if((wx>x-18)and(wx<x+14)) and((wy>y-18)and(wy<y+2)) then
  787.               Falling:=True;
  788.           end;
  789.         end;
  790.       end;
  791.     end;
  792.   begin
  793.     for Ctr:=1 to Weapons do with Weapon[Ctr] do begin
  794.       if Cnt=0 then MoveWpn(Ctr)
  795.       else begin
  796.         Inc(Cnt);
  797.         if Cnt>=Del+(Ord(Fst)*Int) then begin
  798.           Cnt:=0;
  799.           Xps:=320*Ord(Spd<0);
  800.           Fst:=False;
  801.           if Typ=1 then Sound(100) else Sound(900);
  802.         end;
  803.       end;
  804.     end;
  805.   end;
  806.  
  807.   procedure ProcessRope;
  808.   begin
  809.     Orx:=Rx; Ourx:=Urx;
  810.     Inc(Rx,Rxd*4);
  811.     if(Rx<100) or(Rx>204) then Rxd:=-Rxd;
  812.     Urx:=Round(152+(Rx-152) / 1.2);
  813.     SetColor(0); Line(Ourx,20,Orx,76);
  814.     SetColor(3); Line(Urx,20,Rx,76);
  815.   end;
  816.  
  817.   procedure ProcessGuards;
  818.   begin
  819.     if not(GrdNo in [1..3]) then GrdNo:=1;
  820.     Inc(GrdCnt);
  821.     if GrdCnt>10 then begin
  822.       GrdCnt:=1;
  823.       Inc(GrdNo);
  824.       Sound(50);
  825.     end;
  826.     ShowGuards;
  827.   end;
  828.  
  829.   procedure PlayWall;
  830.   begin
  831.     while KeyPressed do Key:=ReadKey;
  832.     Key:=#0;
  833.     repeat
  834.       ox:=x; oy:=y;
  835.       oxd:=xd; oyd:=yd;
  836.       Owlk:=Walk;
  837.       GetShiftStats;
  838.       if(Jmp=0) and(Hanging=0) and not Falling then begin
  839.         if RgtShft then TurnRight else
  840.         if LftShft then TurnLeft else xd:=0;
  841.       end;
  842.       if KeyPressed then begin
  843.         Key:=ReadKey;
  844.         if not Falling then case Key of
  845.           #32,#13:if Jmp=0 then Jmp:=1 else if(Hanging>0) then begin
  846.             Hanging:=0; xd:=Rxd; Jmp:=1;
  847.             if xd<0 then TurnLeft else TurnRight;
  848.             LetGo:=True;
  849.           end;
  850.         end;
  851.         while KeyPressed do Key:=ReadKey;
  852.       end else Key:=#0;
  853.       if xd<>0 then begin
  854.         Count(Walk,1,Wmin,Wmax);
  855.         if not((Jmp>0) or Falling) then if Walk in [2,4,6,8] then
  856.           Sound(85);
  857.       end;
  858.       if(Hanging=0) then begin
  859.         if(xd<>0) then Inc(x,4*xd);
  860.         if x<0 then x:=0;
  861.       end else x:=Rx;
  862.       if(Jmp>0) and(Hanging=0) then ProcessJump;
  863.       if(x>=296) and not Falling then begin
  864.         Reached:=True;
  865.         if y<103 then begin Walk:=10; x:=308;
  866.         end else x:=296;
  867.       end;
  868.       Man;
  869.       Inc(BonCnt);
  870.       if BonCnt=4 then begin
  871.         BonCnt:=0;
  872.         Dec(Bonus,10);
  873.         if Bonus<0 then Bonus:=0;
  874.         ShowBonus;
  875.       end;
  876.       Delay((4-Level)*25-10);
  877.       if not Reached then begin
  878.         if Weapons>0 then ProcessWpn;
  879.         if Rope then ProcessRope;
  880.         if Guards then ProcessGuards;
  881.         BellString;
  882.       end;
  883.       if y=103 then begin
  884.         if Rope then if(x>64)and(x<224) then Falling:=True;
  885.         if Pits then
  886.           if(x>64)and(x<88) or(x>144)and(x<168) or(x>224)and(x<248) then
  887.             Falling:=True;
  888.         if LetGo and not Falling then begin
  889.           ShowScore(10,Off);
  890.           LetGo:=False;
  891.         end;
  892.       end;
  893.       if Falling and(Hanging>0) then begin
  894.         case Rxd of
  895.           -1:TurnLeft;
  896.           +1:TurnRight;
  897.         end;
  898.         Hanging:=0;
  899.         LetGo:=True;
  900.         SetColor(3);
  901.         Black(Ox+Ad[Owlk],oy,17,19);
  902.       end;
  903.       if Key=#27 then Quit:=True;
  904.       NoSound;
  905.       if NumLk then repeat GetShiftStats until not NumLk;
  906.     until Reached or Dead or Quit;
  907.   end;
  908.  
  909.   procedure DoEsmeralda;
  910.   var
  911.     Nman:IcnTyp;
  912.     my:word;
  913.   begin
  914.     Black(x,y,16,19);
  915.     BellString;
  916.     x:=298;
  917.     PutPic(Icon[8],x,y);
  918.     y:=y-18;
  919.     GetImage(x,y,x+16,y+18,Nman);
  920.     PutImage(x,y,Nman,1);
  921.     BellString;
  922.     for my:=y downto 37 do begin
  923.       PutImage(x,my,Nman,1);
  924.       Delay(80);
  925.       PutImage(x,my,Nman,1);
  926.     end;
  927.     PutPic(Icon[5],299,55);
  928.     Delay(700);
  929.     Play('t100O5L4C#<ABE2');
  930.     Delay(200);
  931.     PutPic(Icon[19],301,35);
  932.     Delay(200);
  933.     Play('<EB>C#<A2');
  934.     ShowScore(1000,On);
  935.     Delay(200);
  936.   end;
  937.  
  938. begin
  939.   InitGame;
  940.   repeat
  941.     InitWall;
  942.     PlayWall;
  943.     if Reached then begin
  944.       if WallNo<Walls then begin
  945.         Pause:=0;
  946.         repeat
  947.           Sound(1000);
  948.           Delay(17);
  949.           Pause:=Pause+1;
  950.           NoSound;
  951.           Delay(Pause);
  952.         until Pause>40;
  953.       end;
  954.       ShowScore(Bonus,On);
  955.       if WallNo=Walls then DoEsmeralda;
  956.       Inc(WallNo);
  957.       if WallNo>12 then begin
  958.         WallNo:=1;
  959.         Inc(Level);
  960.         if Level>3 then Level:=3;
  961.       end;
  962.     end else if Dead then begin
  963.       PutPic(Behind,x,y);
  964.       ClearObstacles;
  965.       KillLife;
  966.     end;
  967.   until(Lives=0) or Quit;
  968.   Quit:=False;
  969. end;
  970.  
  971. procedure GameOver;
  972. var Ctr:word;
  973. begin
  974.   SetTextStyle(GothicFont,0,2);
  975.   SetTextJustify(CenterText,TopText);
  976.   for Ctr:=0 to 1 do begin
  977.     SetColor(2+Ctr); OutTextXY(158+Ctr*2,51-Ctr*2,'Game Over');
  978.   end;
  979.   SetTextStyle(DefaultFont,0,1);
  980.   SetTextJustify(LeftText,TopText);
  981.   Ctr:=1; LastPos:=0;
  982.   repeat
  983.     if Score>=Hisc[Ctr].Scor then LastPos:=Ctr;
  984.     Inc(Ctr);
  985.   until (LastPos<>0) or (Ctr>7);
  986.   if LastPos<>0 then begin
  987.     if LastPos<7 then for Ctr:=7 downto LastPos+1 do
  988.       Hisc[Ctr]:=Hisc[Ctr-1];
  989.     Hisc[LastPos].Scor:=Score;
  990.     SetTextStyle(SmallFont,0,5);
  991.     SetColor(1);
  992.     SetTextJustify(CenterText,TopText);
  993.     Wlin(70,'Good job! Enter your name:');
  994.     Hisc[LastPos].Name:=GetInput(10,12,20,3);
  995.   end else begin
  996.     Play('t150l8o3ee4f#d4<b>dd2.');
  997.     Key:=ReadKey;
  998.   end;
  999. end;
  1000.  
  1001. procedure ShutDown;
  1002. begin
  1003.   CloseGraph;
  1004.   TextMode(Co80);
  1005.   Writeln('You''ve just finished playing HUNCHBACK');
  1006.   Writeln('from '+Publ);
  1007.   Writeln('Welcome back for another try, Hunchy!');
  1008.   GotoXY(1,24);
  1009.   Halt;
  1010. end;
  1011.  
  1012. begin
  1013.   Initialize;
  1014.   repeat
  1015.     ShowTitle;
  1016.     if not Quit then begin
  1017.       Game;
  1018.       GameOver;
  1019.     end;
  1020.   until Quit;
  1021.   SaveHiScores;
  1022.   ShutDown;
  1023. end.